meta %>%
filter(su_tract == 1) %>%
select(varname, about) %>% as.list()
## $varname
## [1] "census_tract" "year"
## [3] "conventional" "fha_insured"
## [5] "va_guaranteed" "usda_guaranteed"
## [7] "home_purchase" "home_improve"
## [9] "refinance" "cash_out_refi"
## [11] "other_purpose" "purposeNA"
## [13] "req_preapproval" "noreq_preapproval"
## [15] "originated_loan" "approvedApp_notAccepted"
## [17] "app_denied" "app_withdrawn"
## [19] "fileclosed_incomplete" "purchased_loan"
## [21] "denied_preapproval" "approve_preapproval"
## [23] "appRace_AIAN" "appRace_Asian"
## [25] "appRace_Black" "appRace_HawPI"
## [27] "appRace_White" "appRace_missing"
## [29] "appRace_NA" "appRace_multiracial"
## [31] "appEth_HisLat" "appMale"
## [33] "appFemale" "appsex_missing"
## [35] "highCost_mortgages" "nonHighCost_mortgages"
## [37] "firstlien_secured" "sublien_secured"
## [39] "avg_loan_amount" "med_loan_amount"
## [41] "avg_app_income" "median_app_income"
## [43] "median_income_accepted_app" "white_denial_rate"
## [45] "black_denial_rate" "hislat_denial_rate"
## [47] "loans_per_units" "perc_conventional"
## [49] "perc_govern_backed" "sum_mortgage_dollars_in000s"
## [51] "avg_homepurchase_loanamount" "med_homepurchase_loanamount"
## [53] "total_apps" "perc_app_missingRace"
## [55] "overall_denial_rate" "perc_white_apps"
## [57] "perc_black_apps" "perc_hislat_apps"
## [59] "tract_population" "minority_population"
## [61] "median_family_income" "tract_to_msamd_income"
## [63] "tract_owner_occupied_units" "tract_one_to_four_family_homes"
##
## $about
## [1] "11-digit tract code"
## [2] "The year"
## [3] "The number of conventional loans"
## [4] "The number of loans insured by the Federal Housing Administration"
## [5] "The number of VA guaranteed loans"
## [6] "The number of USDA guaranteed loans"
## [7] "The number of applications or covered loans for home purchase"
## [8] "The number of applications or covered loans for home improvement"
## [9] "The number of applications or covered loans for refinancing"
## [10] "The number of applications or covered loans for cash-out refinancing"
## [11] "The number of applications or covered loans for some other purpose"
## [12] "The number of applications or covered loans for a not applicable purpose"
## [13] "The number of applications or covered loans that requested preapproval of a home purchase loan under a preapproval program"
## [14] "The number of applications or covered loans that did not request preapproval of a home purchase loan under a preapproval program"
## [15] "The number of originated loans"
## [16] "The number of approved but not accepted applications"
## [17] "The number of denied applications"
## [18] "The number of applications withdrawn by the applicant"
## [19] "The number of application files closed for incompleteness"
## [20] "The number of purchased loans"
## [21] "The number of applications for which preapproval was denied"
## [22] "The number of applications for which preapproval request was approved but not accepted"
## [23] "The number of applicants who self-identified as American Indian or Alaska Native"
## [24] "The number of applicants self-identified as Asian including Asian Indian, Chinese, Filipino, Japanese, Korean, Vietnamese, or other Asian countries"
## [25] "The number of applicants who self-identified as Black"
## [26] "The number of applicants who self-identified as Native Hawaiian or Other Pacific Islander"
## [27] "The number of applicants who self-identified as White"
## [28] "The number of applicants who did not provide racial demographic information in their application by mal, internet, or telephone"
## [29] "The number of applicants for which racial identity is not applicable"
## [30] "The number of applicants who selected multiple racial identities"
## [31] "The number of applicants/borrower is Hispanic or Latino"
## [32] "The number of applicants who are male"
## [33] "The number of applicants who are female"
## [34] "The number of applicants who did not provide their sex on their application"
## [35] "The number of covered loans that are high-cost mortgages"
## [36] "The number covered loans that are not a high cost mortgages"
## [37] "The number of covered loans/applications secured by the first lien"
## [38] "The number of covered loans/applications secured by a subordinate lien"
## [39] "The tract average loan amount. This variable seems prone to a high amount of entry error in the individual-level data, so users should be cautious about using the tract-level summary."
## [40] "The tract median loan amount. This variable seems prone to a high amount of entry error in the individual-level data, so users should be cautious about using the tract-level summary."
## [41] "The tract average applicant income. This variable seems prone to a high amount of entry error in the individual-level data, so users should be cautious about using the tract-level summary."
## [42] "The tract median applicant income. This variable seems prone to a high amount of entry error in the individual-level data, so users should be cautious about using the tract-level summary."
## [43] "The tract median income of accepted applications"
## [44] "The tract denial rate for white applicants"
## [45] "The tract denial rate for black applicants"
## [46] "The tract denial rate for Hispanic or Latino applicants"
## [47] "The number of loans per the number of one to four family homes in the tract"
## [48] "The percent of approved applications that were conventional"
## [49] "The percent of approved applications that were backed by the USDA, VA, or FHA"
## [50] "The total amount of the covered loans, or the amounts applied for in the tract"
## [51] "The tract average loan amount for originated loans"
## [52] "The tract median loan amount"
## [53] "The total number of applications in the tract"
## [54] "The percent of applications in which applicants did not disclose their racial identity"
## [55] "The tract denial rate for all applicants"
## [56] "The percent of applications in the tract from White applicants"
## [57] "The percent of applications from Black applicants"
## [58] "The percent of applications from Hispanic or Latino applicants"
## [59] "The population in the tract"
## [60] "The percentage of minority population to total ppulation for tract, rounded to two decimals places"
## [61] "The median family income in the tract"
## [62] "The percentage of tract median family income compared to MSA/MD median family income"
## [63] "The number of dwellings, including individual condominiums, that are lived in by the owner"
## [64] "The number of dwellings that are built to houses with fewer with than 5 families"
glimpse(eastdat)
## Rows: 160
## Columns: 53
## $ census_tract <dbl> 51001090100, 51001090100, 51001090100, …
## $ year <int> 2012, 2013, 2014, 2015, 2016, 2017, 201…
## $ conventional <int> 64, 111, 108, 90, 120, 155, 139, 166, 2…
## $ fha_insured <int> 1, 3, 6, 7, 6, 6, 19, 14, 20, 11, 20, 1…
## $ va_guaranteed <int> 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, …
## $ usda_guaranteed <int> 0, 0, 0, 2, 1, 0, 0, 1, 6, 4, 9, 13, 8,…
## $ req_preapproval <int> 4, 3, 8, 5, 4, 8, 3, 3, 3, 0, 6, 8, 1, …
## $ noreq_preapproval <int> 30, 43, 30, 11, 30, 19, 164, 191, 255, …
## $ originated_loans <int> 47, 65, 68, 66, 89, 109, 103, 113, 167,…
## $ approvedApp_notAccepted <int> 3, 4, 4, 1, 6, 3, 1, 3, 4, 1, 2, 5, 3, …
## $ app_denied <int> 4, 25, 21, 15, 8, 21, 15, 11, 16, 14, 1…
## $ app_withdrawn <int> 4, 3, 11, 8, 16, 11, 18, 28, 22, 1, 5, …
## $ fileclosed_incomplete <int> 0, 1, 1, 3, 3, 6, 6, 4, 5, 1, 1, 4, 8, …
## $ purchased_loan <int> 10, 21, 12, 18, 18, 19, 24, 35, 44, 16,…
## $ denied_preapproval <int> 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, …
## $ approve_preapproval <int> 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, …
## $ appRace_AIAN <int> 0, 0, 0, 3, 0, 0, 0, 0, 1, 0, 0, 0, 2, …
## $ appRace_Asian <int> 0, 0, 1, 1, 1, 0, 0, 0, 4, 0, 1, 0, 1, …
## $ appRace_Black <int> 0, 0, 0, 1, 2, 2, 0, 1, 2, 5, 12, 10, 1…
## $ appRace_HawPI <int> 0, 0, 0, 0, 0, 1, 0, 0, 0, 0, 0, 0, 0, …
## $ appRace_White <int> 53, 93, 101, 88, 110, 137, 146, 153, 19…
## $ appRace_multiracial <int> 0, 0, 0, 0, 0, 1, 0, 0, 3, 0, 0, 0, 4, …
## $ appRace_missing <int> 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, …
## $ appRace_NA <int> 7, 10, 6, 6, 11, 11, 12, 22, 35, 7, 11,…
## $ appEth_HispLat <int> 0, 1, 4, 1, 0, 4, 2, NA, NA, 0, 0, 1, 1…
## $ appMale <int> 37, 63, 65, 62, 86, 95, 95, 96, 128, 39…
## $ appFemale <int> 20, 33, 41, 36, 28, 50, 50, 61, 80, 20,…
## $ appsex_missing <int> 4, 13, 5, 7, 15, 13, 10, 15, 15, 4, 2, …
## $ highCost_mortgages <int> 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, …
## $ nonHighCost_mortgages <int> 68, 119, 117, 111, 140, 169, 60, 69, 91…
## $ firstlien_secured <int> 58, 97, 104, 93, 121, 149, 165, 192, 25…
## $ sublien_secured <int> 0, 1, 1, 0, 1, 1, 2, 2, 2, 0, 0, 1, 2, …
## $ median_income_000s <dbl> 130.0, 106.5, 107.0, 110.5, 118.5, 117.…
## $ med_loan_amount_000s <dbl> 164.0, 162.0, 143.0, 170.0, 177.0, 155.…
## $ total_apps <int> 68, 119, 117, 111, 140, 169, 167, 194, …
## $ overall_denial_rate <dbl> 0.05882353, 0.21008403, 0.17948718, 0.1…
## $ perc_white_apps <dbl> 77.94118, 78.15126, 86.32479, 79.27928,…
## $ perc_black_apps <dbl> 0.0000000, 0.0000000, 0.0000000, 0.9009…
## $ perc_hislat_apps <dbl> 0.0000000, 0.8403361, 3.4188034, 0.9009…
## $ white_denial_rate <dbl> 0.05660377, 0.21505376, 0.17821782, 0.1…
## $ black_denial_rate <dbl> NA, NA, NA, 1.0000000, 0.0000000, 0.500…
## $ hislat_denial_rate <dbl> NA, 0.00, 0.25, 0.00, NA, 0.25, 0.00, N…
## $ median_income_accepted_app <dbl> 134.0, 107.0, 114.0, 118.0, 119.0, 119.…
## $ loans_per_units <dbl> 0.011573504, 0.016005910, 0.016744644, …
## $ perc_conventional <dbl> 97.87234, 93.84615, 94.11765, 86.36364,…
## $ perc_govern_backed <dbl> 2.127660, 6.153846, 5.882353, 13.636364…
## $ sum_mortgage_dollars_in000s <int> 9005, 12187, 12468, 11616, 18309, 20637…
## $ perc_app_missingRace <dbl> 11.764706, 13.445378, 7.692308, 10.8108…
## $ tract_population <int> 2941, 2941, 2941, 2941, 2941, 2930, 293…
## $ minority_population <dbl> 6.02, 6.02, 6.02, 6.02, 6.02, 6.62, 6.6…
## $ median_family_income <int> 52600, 51600, 52000, 52700, 52300, 5330…
## $ tract_owner_occupied_units <int> 1323, 1323, 1323, 1323, 1323, 1095, 109…
## $ tract_one_to_four_family_homes <int> 4061, 4061, 4061, 4061, 4061, 4158, 415…
eastdat[which(eastdat$year == 2020),] %>% select(total_apps, overall_denial_rate, white_denial_rate, black_denial_rate, hislat_denial_rate, perc_conventional, perc_govern_backed) %>%
select(where(~is.numeric(.x))) %>%
as.data.frame() %>%
stargazer(., type = "text", title = "Summary Statistics", digits = 2,
summary.stat = c("mean", "sd", "min", "median", "max"))
##
## Summary Statistics
## ======================================================
## Statistic Mean St. Dev. Min Median Max
## ------------------------------------------------------
## total_apps 121.27 78.66 26 105 258
## overall_denial_rate 0.11 0.04 0.06 0.11 0.19
## white_denial_rate 0.09 0.04 0.04 0.07 0.18
## black_denial_rate 0.27 0.26 0 0.3 1
## hislat_denial_rate 0.06 0.10 0.00 0.00 0.17
## perc_conventional 70.86 11.58 53.85 68.00 88.62
## perc_govern_backed 29.14 11.58 11.38 32.00 46.15
## ------------------------------------------------------
longdat <- eastdat[which(eastdat$year == 2020),] %>% select(c(census_tract, total_apps, overall_denial_rate, white_denial_rate, black_denial_rate, hislat_denial_rate, perc_conventional, perc_govern_backed)) %>% pivot_longer(-census_tract, names_to = "measure", values_to = "value")
longdat$measure <- factor(longdat$measure,
levels = c("total_apps", "overall_denial_rate", "white_denial_rate", "black_denial_rate", "hislat_denial_rate", "perc_conventional", "perc_govern_backed"))
longdat %>%
ggplot(aes(x = value, fill = measure)) +
scale_fill_viridis(option = "plasma", discrete = TRUE, guide = FALSE) +
geom_histogram() +
facet_wrap(~measure, scales = "free")
## `stat_bin()` using `bins = 30`. Pick better value with `binwidth`.
## Warning: Removed 8 rows containing non-finite values (stat_bin).
meta %>%
filter(varname %in% c("total_apps", "overall_denial_rate", "white_denial_rate", "black_denial_rate", "hislat_denial_rate", "perc_conventional", "perc_govern_backed")) %>%
mutate(label = paste0(varname, ": ", about)) %>%
select(label) %>%
as.list()
$label [1] "white_denial_rate: The tract denial rate for white applicants"
[2] "black_denial_rate: The tract denial rate for black applicants"
[3] "hislat_denial_rate: The tract denial rate for Hispanic or Latino applicants"
[4] "perc_conventional: The percent of approved applications that were conventional"
[5] "perc_govern_backed: The percent of approved applications that were backed by the USDA, VA, or FHA" [6] "total_apps: The total number of applications in the tract"
[7] "overall_denial_rate: The tract denial rate for all applicants"
mapdat2020 <- mapdat[which(mapdat$year == 2020),]
pal <- colorNumeric("plasma", reverse = TRUE, domain = mapdat2020$total_apps)
leaflet() %>%
addProviderTiles("CartoDB.Positron") %>%
addPolygons(data = mapdat2020,
fillColor = ~pal(mapdat2020$total_apps),
weight = 1,
opacity = 1,
color = "white",
fillOpacity = 0.6,
highlight = highlightOptions(
weight = 2,
fillOpacity = 0.8,
bringToFront = T
),
popup = paste0("GEOID: ", mapdat2020$census_tract, "<br>",
"Number of applications: ", mapdat2020$total_apps)
) %>%
addLegend("bottomright", pal = pal, values = (mapdat2020$total_apps),
title = "Total number of <br>mortgage applications <br> in 2020", opacity = 0.7)
mapdat <- mapdat %>%
group_by(census_tract) %>%
mutate(avg_overall_denial_rate = mean(na.omit(overall_denial_rate))) %>%
ungroup()
pal <- colorNumeric("plasma", reverse = TRUE, domain = mapdat$avg_overall_denial_rate)
leaflet() %>%
addProviderTiles("CartoDB.Positron") %>%
addPolygons(data = mapdat,
fillColor = ~pal(mapdat$avg_overall_denial_rate),
weight = 1,
opacity = 1,
color = "white",
fillOpacity = 0.6,
highlight = highlightOptions(
weight = 2,
fillOpacity = 0.8,
bringToFront = T
),
popup = paste0("GEOID: ", mapdat$census_tract, "<br>",
"Average overall app denial rate from 2007-2020: ", round(mapdat$avg_overall_denial_rate, 2))
) %>%
addLegend("bottomright", pal = pal, values = (mapdat$avg_overall_denial_rate),
title = "Average overall <br>app denial rate <br>from 2007-2020", opacity = 0.7)
mapdat <- mapdat %>%
group_by(census_tract) %>%
mutate(avg_white_denial_rate = mean(na.omit(white_denial_rate))) %>%
ungroup()
pal <- colorNumeric("plasma", reverse = TRUE, domain = mapdat$avg_white_denial_rate)
leaflet() %>%
addProviderTiles("CartoDB.Positron") %>%
addPolygons(data = mapdat,
fillColor = ~pal(mapdat$avg_white_denial_rate),
weight = 1,
opacity = 1,
color = "white",
fillOpacity = 0.6,
highlight = highlightOptions(
weight = 2,
fillOpacity = 0.8,
bringToFront = T
),
popup = paste0("GEOID: ", mapdat$census_tract, "<br>",
"Average White app denial rate from 2007-2020: ", round(mapdat$avg_white_denial_rate, 2))
) %>%
addLegend("bottomright", pal = pal, values = (mapdat$avg_white_denial_rate),
title = "Average White <br>app denial rate <br>from 2007-2020", opacity = 0.7)
mapdat <- mapdat %>%
group_by(census_tract) %>%
mutate(avg_black_denial_rate = mean(na.omit(black_denial_rate))) %>%
ungroup()
pal <- colorNumeric("plasma", reverse = TRUE, domain = (mapdat$avg_black_denial_rate))
leaflet() %>%
addProviderTiles("CartoDB.Positron") %>%
addPolygons(data = mapdat,
fillColor = ~pal((mapdat$avg_black_denial_rate)),
weight = 1,
opacity = 1,
color = "white",
fillOpacity = 0.6,
highlight = highlightOptions(
weight = 2,
fillOpacity = 0.8,
bringToFront = T
),
popup = paste0("GEOID: ", mapdat$census_tract, "<br>",
"Average Black app denial rate from 2007-2020: ", round(mapdat$avg_black_denial_rate, 2))
) %>%
addLegend("bottomright", pal = pal, values = (mapdat$avg_black_denial_rate),
title = "Average Black <br>app denial rate <br>from 2007-2020", opacity = 0.7)
mapdat <- mapdat %>%
group_by(census_tract) %>%
mutate(avg_hislat_denial_rate = mean(na.omit(hislat_denial_rate))) %>%
ungroup()
pal <- colorNumeric("plasma", reverse = TRUE, domain = (mapdat$avg_hislat_denial_rate))
leaflet() %>%
addProviderTiles("CartoDB.Positron") %>%
addPolygons(data = mapdat,
fillColor = ~pal((mapdat$avg_hislat_denial_rate)),
weight = 1,
opacity = 1,
color = "white",
fillOpacity = 0.6,
highlight = highlightOptions(
weight = 2,
fillOpacity = 0.8,
bringToFront = T
),
popup = paste0("GEOID: ", mapdat$census_tract, "<br>",
"Average His/Lat app denial rate from 2007-2020: ", round(mapdat$avg_hislat_denial_rate, 2))
) %>%
addLegend("bottomright", pal = pal, values = (mapdat$avg_hislat_denial_rate),
title = "Average Hispanic/Latino <br>app denial rate <br>from 2007-2020", opacity = 0.7)
shape <- readRDS('eastshore_tracts.RDS')
shape <- shape %>% dplyr::rename(census_tract = GEOID)
animatemapdat <- merge(shape, eastdat, by = 'census_tract', all.x = T)
animatemapdat <- st_as_sf(animatemapdat)
animatemapdat$year = as.numeric(animatemapdat$year)
animatemapdat <- animatemapdat %>% filter_at(vars(NAME, geometry, perc_govern_backed),all_vars(!is.na(.)))
cville1 <-
ggplot(animatemapdat) +
geom_sf(aes(fill = perc_govern_backed), color = "black", alpha = .9, na.rm = TRUE) +
scale_fill_fermenter(palette = "Blues", direction = 1, type = "seq", n.breaks = 7) +
theme_void() +
guides(fill = guide_colourbar(title.position="top", title.hjust = 0.5, barwidth = 1)) +
labs(fill = "Percent of mortgages backed by gov.", title = 'Year:{frame_time}',
caption = "Percent of approved mortgage apps backed by the USDA, VA, or FHA") +
transition_time(as.integer(year)) +
ease_aes('linear')
animate(cville1, fps = 1, nframes = 13)
mapdat <- mapdat %>%
group_by(census_tract) %>%
mutate(avg_percgovbacked = mean(na.omit(perc_govern_backed))) %>%
ungroup()
pal <- colorNumeric("plasma", reverse = TRUE, domain = mapdat$avg_percgovbacked)
leaflet() %>%
addProviderTiles("CartoDB.Positron") %>%
addPolygons(data = mapdat,
fillColor = ~pal(mapdat$avg_percgovbacked),
weight = 1,
opacity = 1,
color = "white",
fillOpacity = 0.6,
highlight = highlightOptions(
weight = 2,
fillOpacity = 0.8,
bringToFront = T
),
popup = paste0("GEOID: ", mapdat$census_tract, "<br>",
"Average % of gov-backed mortgages <br> from 2006-2020: ", round(mapdat$avg_percgovbacked, 2))
) %>%
addLegend("bottomright", pal = pal, values = (mapdat$avg_percgovbacked),
title = "Average % of <br>gov-backed mortgages <br>from 2007-2020", opacity = 0.7)
mapdat2020 <- mapdat[which(mapdat$year == 2020),]
pal <- colorNumeric("plasma", reverse = TRUE, domain = mapdat2020$perc_govern_backed)
leaflet() %>%
addProviderTiles("CartoDB.Positron") %>%
addPolygons(data = mapdat2020,
fillColor = ~pal(mapdat2020$perc_govern_backed),
weight = 1,
opacity = 1,
color = "white",
fillOpacity = 0.6,
highlight = highlightOptions(
weight = 2,
fillOpacity = 0.8,
bringToFront = T
),
popup = paste0("GEOID: ", mapdat2020$census_tract, "<br>",
"Percent of gov-backed <br>mortages in 2020: ", round(mapdat2020$perc_govern_backed, 2))
) %>%
addLegend("bottomright", pal = pal, values = (mapdat2020$perc_govern_backed),
title = "Percent of <br>gov-backed <br>mortages in 2020", opacity = 0.7)